subroutine ccsdt_sym_aaa_dg_l2(ie, t1, t2, t22, iijka, iabij, & 
                    tmp1, tmp2, tmp3, tmp4, iabci, & 
                    icore, e4t, e5st, ig)
use mod_iop
use mod_orbit
use mod_size
use mod_symm
use mod_t
implicit none
integer prec2, isd2, igpu2, totgpu2
common/precsoc/prec2, isd2, igpu2, totgpu2 
real*8, intent(in) :: e4t, e5st
real*8, intent(in) :: ie(*), t1(*), t2(*), t22(*), tmp4(*)
real*8, intent(in) :: iijka(*), iabij(*), tmp1(*), tmp2(*), tmp3(*)
real*8, intent(in) :: iabci(*)
!
real*8, intent(in) :: icore(*)
real*8, intent(in),device :: ig(*)
integer i0, i1, i2, i3, nsize
integer i4, i5, i6, i7, i8, i9, i10
integer i11, i12, i13, i14, i15, i16, i17, i18, i19, i20
integer irrepi, numi, nabc, nabci, iread, iter, ileft
integer it, itend, icopy, ioffi
integer ioffvvvo(noa,8), ioffvvoo2(noa, 8), ioffvo(noa, 8)
integer ioffvooo(noa,noa,8,8), ioffvvoo(noa,noa,8,8)
!
integer irrepki, irrepij, irrepjk, irrepabc, numj, numk
integer irrepj, irrepk, i, j, k, iofftmp
integer, external :: idsymsoc, irpdso
real*8, external :: nrm2so
igpu=0; igpu2=0
i0 = 1
i1 = i0 + nvvoo
i2 = i1 + nvvoo
!
!calcioff
call idxpqr_s(ioffvvvo, noa, vrta, vrta, 0, vrta, popa, 1, 1)
call idxpqr_s(ioffvvoo2, noa, vrta, vrta, 0, popa, popa, 1, 1)
call idxpqr_s(ioffvo, noa, zorb, zorb, 1, vrta, popa, 1, 1)
!
call idxpq_rs(ioffvvoo, noa, noa, vrta, vrta, 1, popa, popa, 1, 1)
call idxpq_rs(ioffvooo, noa, noa, popa, vrta, 1, popa, popa, 1, 1)
!
!=======get t1
!
call getuhf(t1, 1, 'T1AA____')
!
!=======get t2
!
call getuhf(icore(i0), 1, 'T2AA____')
call iexpso(icore(i0), icore(i1), vrta, vrta, 0, 0, popa, popa, 0, 1, 1)
call sstgenso(icore(i1), t22, nsize, nvvaa, zorb,  popa, popa, & 
             icore, 1, '1324')
call iexpso(icore(i1), t2, vrta, vrta, 0, 1, popa, popa, 1, 0, 1)
if(ldebug) then 
nsize = idsymsoc(1, vrta, vrta, 1, popa, popa, 1)
write(6,*)'norm of t2', nrm2so(nsize, t2, 1)
nsize = idsymsoc(1, vrta, vrta, 0, popa, popa, 1)
write(6,*)'norm of t22', nrm2so(nsize, t22, 1)
endif
!
!=======get iabij(a<b,i<j) and transfer to iabij(a<b, i,j) 
!
call getuhf(icore(i0), 1, 'ABIJAA__')
call iexpso(icore(i0), icore(i1), vrta, vrta, 0, 0, popa, popa, 0, 1, 1)
call iexpso(icore(i1), iabij,     vrta, vrta, 0, 1, popa, popa, 1, 0, 1)
!
!=======get iijka(i<j,k,a) and transfer to iijka(k,a,i,j)
!
call getuhf(icore(i0), 1, 'IJKAAA__')
call itranspso(icore(i0), icore(i1), popa, popa, 0, popa, vrta, 1, 1)
call iexpso(icore(i1), iijka, popa, vrta, 1, 0, popa, popa, 0, 1, 1)
!
if(ldebug) then 
nsize = idsymsoc(1, popa, popa, 1, vrta, popa, 1) 
write(6,*)'norm of iijkaaa', nrm2so(nsize, iijka, 1)
endif
! 
!=======get iabci aa
!
call getuhf(iabci, 1, 'ABCIAA__')
if(ldebug) then 
nsize = idsymsoc(1, vrta, vrta, 0, vrta, popa, 1) 
write(6,*)'norm of iabciaa', nrm2so(nsize, iabci, 1)
endif
do irrepi = 1, nirrep
   numi = popa(irrepi)
   do i = 1, numi
   iofftmp = ioffvvvo(i, irrepi)
!   write(6,*)'ioff', iofftmp
   call getpqrso(iabci(iofftmp), i, irrepi, 1, 'ABCIAA__')
   enddo
enddo
if(ldebug) then 
nsize = idsymsoc(1, vrta, vrta, 0, vrta, popa, 1) 
write(6,*)'norm of iabciaa', nrm2so(nsize, iabci, 1)
endif
!
igpu=1; igpu2=1
i0  = 1
i1  = i0  + nva+noa+nvb+nob  ! ie
i2  = i1  + nvomax           ! t1
nsize = idsymsoc(1, vrta, vrta, 0, popa, popa, 1) 
i3  = i2  + nsize            ! t22
call myicopy_g(ie,  ig(i0), nva+noa+nvb+nob)
call myicopy_g(t1,  ig(i1), nvomax)
call myicopy_g(t22, ig(i2), nvvoo*3)
do irrepk = 1, nirrep 
do irrepj = 1, nirrep
do irrepi = 1, nirrep 
   irrepij = dirprd(irrepi, irrepj) 
   irrepjk = dirprd(irrepj, irrepk) 
   irrepki = dirprd(irrepk, irrepi) 
   irrepabc = dirprd(irrepij, irrepk)
   numi = popa(irrepi)
   numj = popa(irrepj) 
   numk = popa(irrepk)
   nabci = idsymsoc(irrepi, vrta, vrta, 0, vrta, zorb, 1)
   nabc = max(idsymsoc(irrepi, vrta, vrta, 0, vrta, zorb, 1), &
              idsymsoc(irrepj, vrta, vrta, 0, vrta, zorb, 1), &
              idsymsoc(irrepk, vrta, vrta, 0, vrta, zorb, 1))
!   write(6,*)'nvvmax',nvvmax, nvomax, nvvv
   i4  = i3  + nvvmax           ! t2ij 
   i5  = i4  + nvvmax           ! t2jk
   i6  = i5  + nvvmax           ! t2ki
   i7  = i6  + nvomax           ! iijkaij 
   i8  = i7  + nvomax           ! iijkajk
   i9  = i8  + nvomax           ! iijkaki
   i10 = i9  + nvvmax           ! iabijij
   i11 = i10 + nvvmax           ! iabijjk
   i12 = i11 + nvvmax           ! iabijki
   i13 = i12 + nvvv             ! tmp1
   i14 = i13 + nvvv             ! tmp2
   i15 = i14 + nvvv             ! tmp3
   i16 = i15 + nvvv             ! tmp4
   i17 = i16 + nabc             ! iabci_k
   i18 = i17 + nabc             ! iabci_j
   igpuleft = igpusize  - i18
   iread = min(igpuleft/nvvv/2, nvvvo/nvvv+1)  
   i19 = i18 + nabc*iread           ! iabci_i
    if(irrepi>irrepj.or.irrepj>irrepk.or.irrepi>irrepk) cycle
    if(irrepi==irrepj.and.irrepj==irrepk) then
     iter = 0
     ileft = numi
     do it = 1, numi
        if(it==iter*iread+1) then
        itend = it+iread-1
        iter = iter + 1
        icopy = min(iread, ileft)
        if(icopy<0) icopy = icopy+iread
        if(ldebug) then
            write(6,'(A,I4, I4, I4)')'iter, iread and icopy',iter, iread, icopy
        endif
        call myicopy_g(iabci(ioffvvvo(it,irrepi)),ig(i18), nabci*icopy)
        ileft = numi-iter*iread
      do k = 3, numk 
         call myicopy_g(iabci(ioffvvvo(k,irrepk)), ig(i16), nabc)
      do j = 2, k-1 
         call myicopy_g(t2(ioffvvoo(j,k,irrepj,irrepk)), ig(i4), nvvmax)
         call myicopy_g(iijka(ioffvooo(j,k,irrepj,irrepk)), ig(i7), nvomax)
         call myicopy_g(iabij(ioffvvoo(j,k,irrepj,irrepk)), ig(i10), nvvmax)
         call myicopy_g(iabci(ioffvvvo(j,irrepj)), ig(i17), nabc)
      ioffi = 0
      do i = 1, j-1 
         if(i<it.or.i>itend) cycle 
         call myicopy_g(t2(ioffvvoo(i,j,irrepi,irrepj)), ig(i3), nvvmax)
         call myicopy_g(t2(ioffvvoo(k,i,irrepk,irrepi)), ig(i5), nvvmax)
!      
         call myicopy_g(iijka(ioffvooo(i,j,irrepi,irrepj)), ig(i6), nvomax)
         call myicopy_g(iijka(ioffvooo(k,i,irrepk,irrepi)), ig(i8), nvomax)
!      
         call myicopy_g(iabij(ioffvvoo(i,j,irrepi,irrepj)), ig(i9), nvvmax)
         call myicopy_g(iabij(ioffvvoo(k,i,irrepk,irrepi)), ig(i11), nvvmax)
!      
!         call myicopy_g(iabci(ioffvvvo(i,irrepi)), ig(i18), nabc)
      call ccsdt_calcaaa_2(ig(i0), &
!---t1
           ig(i1-1+ioffvo(i,irrepi)), ig(i1-1+ioffvo(j,irrepj)), ig(i1-1+ioffvo(k,irrepk)), &
!---t2(ab,ij)
           ig(i3), ig(i4), ig(i5), &
!---t22(abi,j)
           ig(i2-1+ioffvvoo2(i,irrepi)), ig(i2-1+ioffvvoo2(j,irrepj)), &
           ig(i2-1+ioffvvoo2(k,irrepk)), & 
!---iabci(abc,i)
           ig(ioffi+i18), ig(i17), ig(i16), &
!---iijka(ka,ij)
           ig(i6), ig(i7), ig(i8),&
!---iabij(ab,ij)
           ig(i9), ig(i10), ig(i11), &
           ig(i12), ig(i13), ig(i14), ig(i15), ig(i19),& 
           irrepi, irrepj, irrepk, i, j, k,& 
           ioffvvvo, ioffvvoo2, ioffvvoo, ioffvooo, ioffvo, &
           e4t, e5st, vrta, vrtb, popa, popb, 1)
!
           ioffi = ioffi + nabci
         enddo
         enddo
         enddo
        endif
        enddo
      elseif(irrepi==irrepj.and.irrepj<irrepk) then
     iter = 0
     ileft = numi
     do it = 1, numi
        if(it==iter*iread+1) then
        itend = it+iread-1
        iter = iter + 1
        icopy = min(iread, ileft)
        if(icopy<0) icopy = icopy+iread
        if(ldebug) then
        write(6,'(A,I4, I4, I4)')'iter, iread and icopy',iter, iread, icopy
        endif
        call myicopy_g(iabci(ioffvvvo(it,irrepi)),ig(i18), nabci*icopy)
        ileft = numi-iter*iread
        do k = 1, numk
      call myicopy_g(iabci(ioffvvvo(k,irrepk)), ig(i16), nabc)
        do j = 2, numj
      call myicopy_g(t2(ioffvvoo(j,k,irrepj,irrepk)), ig(i4), nvvmax)
      call myicopy_g(iijka(ioffvooo(j,k,irrepj,irrepk)), ig(i7), nvomax)
      call myicopy_g(iabij(ioffvvoo(j,k,irrepj,irrepk)), ig(i10), nvvmax)
      call myicopy_g(iabci(ioffvvvo(j,irrepj)), ig(i17), nabc)
        ioffi = 0
        do i = 1, j-1 
        if(i<it.or.i>itend) cycle 
      call myicopy_g(t2(ioffvvoo(i,j,irrepi,irrepj)), ig(i3), nvvmax)
      call myicopy_g(t2(ioffvvoo(k,i,irrepk,irrepi)), ig(i5), nvvmax)
!
      call myicopy_g(iijka(ioffvooo(i,j,irrepi,irrepj)), ig(i6), nvomax)
      call myicopy_g(iijka(ioffvooo(k,i,irrepk,irrepi)), ig(i8), nvomax)
!
      call myicopy_g(iabij(ioffvvoo(i,j,irrepi,irrepj)), ig(i9), nvvmax)
      call myicopy_g(iabij(ioffvvoo(k,i,irrepk,irrepi)), ig(i11), nvvmax)
!
!      call myicopy_g(iabci(ioffvvvo(i,irrepi)), ig(i18), nabc)
      call ccsdt_calcaaa_2(ig(i0), &
!---t1
           ig(i1-1+ioffvo(i,irrepi)), ig(i1-1+ioffvo(j,irrepj)),ig(i1-1+ioffvo(k,irrepk)), &
!---t2(ab,ij)
           ig(i3), ig(i4), ig(i5), &
!---t22(abi,j)
           ig(i2-1+ioffvvoo2(i,irrepi)), ig(i2-1+ioffvvoo2(j,irrepj)), &
           ig(i2-1+ioffvvoo2(k,irrepk)), &
!---iabci(abc,i)
           ig(ioffi+i18), ig(i17), ig(i16), &
!---iijka(ka,ij)
           ig(i6), ig(i7), ig(i8),&
!---iabij(ab,ij)
           ig(i9), ig(i10), ig(i11), &
           ig(i12), ig(i13), ig(i14), ig(i15), ig(i19),&
           irrepi, irrepj, irrepk, i, j, k,&
           ioffvvvo, ioffvvoo2, ioffvvoo, ioffvooo, ioffvo, &
           e4t, e5st, vrta, vrtb, popa, popb, 1)
           ioffi = ioffi+nabci
        enddo
        enddo
        enddo
       endif
      enddo
      elseif(irrepi<irrepj.and.irrepj==irrepk) then
     iter = 0
     ileft = numi
     do it = 1, numi
        if(it==iter*iread+1) then
        itend = it+iread-1
        iter = iter + 1
        icopy = min(iread, ileft)
        if(icopy<0) icopy = icopy+iread
        if(ldebug) then
        write(6,'(A,I4, I4, I4)')'iter, iread and icopy',iter, iread, icopy
        endif
        call myicopy_g(iabci(ioffvvvo(it,irrepi)),ig(i18), nabci*icopy)
        ileft = numi-iter*iread
        do k = 2, numk
      call myicopy_g(iabci(ioffvvvo(k,irrepk)), ig(i16), nabc)
        do j = 1, k-1
      call myicopy_g(t2(ioffvvoo(j,k,irrepj,irrepk)), ig(i4), nvvmax)
      call myicopy_g(iijka(ioffvooo(j,k,irrepj,irrepk)), ig(i7), nvomax)
      call myicopy_g(iabij(ioffvvoo(j,k,irrepj,irrepk)), ig(i10), nvvmax)
      call myicopy_g(iabci(ioffvvvo(j,irrepj)), ig(i17), nabc)
        ioffi = 0
        do i = 1, numi 
        if(i<it.or.i>itend) cycle 
      call myicopy_g(t2(ioffvvoo(i,j,irrepi,irrepj)), ig(i3), nvvmax)
      call myicopy_g(t2(ioffvvoo(k,i,irrepk,irrepi)), ig(i5), nvvmax)
!
      call myicopy_g(iijka(ioffvooo(i,j,irrepi,irrepj)), ig(i6), nvomax)
      call myicopy_g(iijka(ioffvooo(k,i,irrepk,irrepi)), ig(i8), nvomax)
!
      call myicopy_g(iabij(ioffvvoo(i,j,irrepi,irrepj)), ig(i9), nvvmax)
      call myicopy_g(iabij(ioffvvoo(k,i,irrepk,irrepi)), ig(i11), nvvmax)
!
!      call myicopy_g(iabci(ioffvvvo(i,irrepi)), ig(i18), nabc)
      call ccsdt_calcaaa_2(ig(i0), &
!---t1
           ig(i1-1+ioffvo(i,irrepi)), ig(i1-1+ioffvo(j,irrepj)),ig(i1-1+ioffvo(k,irrepk)), &
!---t2(ab,ij)
           ig(i3), ig(i4), ig(i5), &
!---t22(abi,j)
           ig(i2-1+ioffvvoo2(i,irrepi)), ig(i2-1+ioffvvoo2(j,irrepj)), &
           ig(i2-1+ioffvvoo2(k,irrepk)), &
!---iabci(abc,i)
           ig(ioffi+i18), ig(i17), ig(i16), &
!---iijka(ka,ij)
           ig(i6), ig(i7), ig(i8),&
!---iabij(ab,ij)
           ig(i9), ig(i10), ig(i11), &
           ig(i12), ig(i13), ig(i14), ig(i15), ig(i19),&
           irrepi, irrepj, irrepk, i, j, k,&
           ioffvvvo, ioffvvoo2, ioffvvoo, ioffvooo, ioffvo, &
           e4t, e5st, vrta, vrtb, popa, popb, 1)
           ioffi = ioffi+nabci
        enddo
        enddo
        enddo
       endif
      enddo
      elseif(irrepi<irrepj.and.irrepj<irrepk) then
     iter = 0
     ileft = numi
     do it = 1, numi
        if(it==iter*iread+1) then
        itend = it+iread-1
        iter = iter + 1
        icopy = min(iread, ileft)
        if(icopy<0) icopy = icopy+iread
        if(ldebug) then
        write(6,'(A,I4, I4, I4)')'iter, iread and icopy',iter, iread, icopy
        endif
        call myicopy_g(iabci(ioffvvvo(it,irrepi)),ig(i18), nabci*icopy)
        ileft = numi-iter*iread
        do k = 1, numk
      call myicopy_g(iabci(ioffvvvo(k,irrepk)), ig(i16), nabc)
        do j = 1, numj
      call myicopy_g(t2(ioffvvoo(j,k,irrepj,irrepk)), ig(i4), nvvmax)
      call myicopy_g(iijka(ioffvooo(j,k,irrepj,irrepk)), ig(i7), nvomax)
      call myicopy_g(iabij(ioffvvoo(j,k,irrepj,irrepk)), ig(i10), nvvmax)
      call myicopy_g(iabci(ioffvvvo(j,irrepj)), ig(i17), nabc)
        ioffi=0
        do i = 1, numi
        if(i<it.or.i>itend) cycle 
      call myicopy_g(t2(ioffvvoo(i,j,irrepi,irrepj)), ig(i3), nvvmax)
      call myicopy_g(t2(ioffvvoo(k,i,irrepk,irrepi)), ig(i5), nvvmax)
!
      call myicopy_g(iijka(ioffvooo(i,j,irrepi,irrepj)), ig(i6), nvomax)
      call myicopy_g(iijka(ioffvooo(k,i,irrepk,irrepi)), ig(i8), nvomax)
!
      call myicopy_g(iabij(ioffvvoo(i,j,irrepi,irrepj)), ig(i9), nvvmax)
      call myicopy_g(iabij(ioffvvoo(k,i,irrepk,irrepi)), ig(i11), nvvmax)
!
!      call myicopy_g(iabci(ioffvvvo(i,irrepi)), ig(i18), nabc)
      call ccsdt_calcaaa_2(ig(i0), &
!---t1
           ig(i1-1+ioffvo(i,irrepi)), ig(i1-1+ioffvo(j,irrepj)),ig(i1-1+ioffvo(k,irrepk)), &
!---t2(ab,ij)
           ig(i3), ig(i4), ig(i5), &
!---t22(abi,j)
           ig(i2-1+ioffvvoo2(i,irrepi)), ig(i2-1+ioffvvoo2(j,irrepj)), &
           ig(i2-1+ioffvvoo2(k,irrepk)), &
!---iabci(abc,i)
           ig(ioffi+i18), ig(i17), ig(i16), &
!---iijka(ka,ij)
           ig(i6), ig(i7), ig(i8),&
!---iabij(ab,ij)
           ig(i9), ig(i10), ig(i11), &
           ig(i12), ig(i13), ig(i14), ig(i15), ig(i19),&
           irrepi, irrepj, irrepk, i, j, k,&
           ioffvvvo, ioffvvoo2, ioffvvoo, ioffvooo, ioffvo, &
           e4t, e5st, vrta, vrtb, popa, popb, 1)
           ioffi = ioffi+nabci
        enddo
        enddo
        enddo
       endif
      enddo
     endif
enddo
enddo
enddo
igpu=0; igpu2=0
write(6,*)'e4t and e5st for aaa', e4t, e5st 
return
end
